home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / pc / LOGIC Apple II 5.25" Library - DOS Part 3 / DOS075.dsk / CALENDAR.bas < prev    next >
BASIC Source File  |  2012-02-16  |  8KB  |  256 lines
  1. 100  GOTO 30000
  2. 200  REM ** SET WINDOW **
  3. 210  POKE 32,1: POKE 33,37: POKE 34,1: POKE 35,16: HOME : RETURN 
  4. 3000  REM *** CHOICE OF MONTH ***
  5. 3004  GOSUB 210: VTAB 7: HTAB 4
  6. 3010  INPUT "TWO NUMBERS:(YYYY,MM)? ";Y,M
  7. 3014  IF Y >1581  AND M >0  AND M <13  THEN 3990
  8. 3020  PRINT "PARDON?"; CHR$(7): GOTO 3010
  9. 3990  RETURN 
  10. 5000  REM *** DISPLAY MONTH ***
  11. 5010  GOSUB 200
  12. 5020 YY =  INT(Y -1):MM =  INT(M +10): IF MM <13  THEN 5040
  13. 5030 MM = MM -12:YY = YY +1
  14. 5040 DD =  INT(D0 +F0(MM) + INT(YY/4) + INT(YY/400) - INT(YY/100) +YY)
  15. 5050 DD =  INT(1.0001 +DD -7 * INT(DD/7))
  16. 5060  VTAB 4: HTAB 17 - LEN(MO$(MM))/2
  17. 5070  PRINT MO$(MM);", ";Y
  18. 5080  VTAB 8: HTAB 6
  19. 5090  PRINT "SUN MON TUE WED THR FRI SAT"
  20. 5100  IF MM <12  THEN 5200
  21. 5110 LAST = 28
  22. 5120  IF  INT(Y -4 * INT(Y/4)) = 0  AND  INT(Y -100 * INT(Y/100)) < >0  THEN LAST = 29
  23. 5130  IF  INT(Y -400 * INT(Y/400)) = 0  THEN LAST = 29
  24. 5140  GOTO 5300
  25. 5200 LAST = F0(MM +1) -F0(MM)
  26. 5300 FIRST = DD:D1 = 1
  27. 5310  FOR WEEK = 1 TO 6: VTAB 9 +WEEK: FOR DAY = 1 TO 7: HTAB 4 *DAY +2
  28. 5320  IF D1 = 1  AND DAY <FIRST  THEN 5360
  29. 5330  IF D1 >LAST  THEN 5360
  30. 5340  IF D1 <10  THEN  PRINT  CHR$(32);
  31. 5350  PRINT D1;:D1 = D1 +1
  32. 5360  NEXT : NEXT 
  33. 5370  TEXT 
  34. 5990  RETURN 
  35. 6000  REM **** BUILD 3 MONTHS ****
  36. 6001  REM   USED BY PRINTER
  37. 6002  REM 
  38. 6010  FOR I = 1 TO 7:LINE$(I) = "": FOR J = 1 TO 80:LINE$(I) = LINE$(I) + CHR$(32): NEXT :X =  FRE(0): NEXT 
  39. 6020  FOR M1 = 1 TO 3:M = 3 *A +M1
  40. 6030 YY =  INT(Y -1):MM =  INT(M +10): IF MM <13  THEN 6050
  41. 6040 MM = MM -12:YY = YY +1
  42. 6050 DD =  INT(D0 +F0(MM) + INT(YY/4) + INT(YY/400) - INT(YY/100) +YY)
  43. 6060 DD =  INT(1.0001 +DD -7 * INT(DD/7))
  44. 6070 LINE$(7) =  LEFT$(LINE$(7),T(M1)) +MO$(MM) + RIGHT$(LINE$(7), LEN(LINE$(7)) -T(M1) - LEN(MO$(MM)))
  45. 6080  IF MM <12  THEN 6120
  46. 6090 LAST = 28: IF  INT(Y -4 * INT(Y/4)) = 0  AND  INT(Y -100 * INT(Y/100)) < >0  THEN LAST = 29
  47. 6110  GOTO 6200
  48. 6120 LAST = F0(MM +1) -F0(MM)
  49. 6200 FIRST = DD:D1 = 1
  50. 6210  FOR WEEK = 1 TO 6: FOR DAY = 1 TO 7
  51. 6220  IF D1 = 1  AND DAY <FIRST  THEN 6290
  52. 6230  IF D1 >LAST  THEN 6290
  53. 6240 A$ =  STR$(D1)
  54. 6250 LINE$(WEEK) =  LEFT$(LINE$(WEEK),T(M1) +3 *DAY - LEN(A$)) +A$ + RIGHT$(LINE$(WEEK), LEN(LINE$(WEEK)) -T(M1) -3 *DAY)
  55. 6260 D1 = D1 +1
  56. 6290  NEXT 
  57. 6292  NEXT 
  58. 6294  NEXT M1
  59. 6990  RETURN 
  60. 21000  REM **** SCREEN MENU ****
  61. 21010  TEXT : HOME 
  62. 21020  INVERSE : VTAB 1: HTAB 1: FOR I = 1 TO 39: PRINT  CHR$(32);: NEXT 
  63. 21030  FOR I = 1 TO 18: VTAB I: HTAB 1: PRINT  CHR$(32);: HTAB 39: PRINT  CHR$(32);: NEXT 
  64. 21040  VTAB 18: HTAB 1: FOR I = 1 TO 39: PRINT  CHR$(32);: NEXT 
  65. 21050  NORMAL 
  66. 21060  GOSUB 3000: REM  CHOICE
  67. 21070  GOSUB 5000: REM  DISPLAY MONTH
  68. 21080  TEXT : VTAB 20:T = 8
  69. 21090  HTAB T: PRINT " <LEFT> ... LAST MONTH"
  70. 21100  HTAB T: PRINT "<RIGHT> ... NEXT MONTH"
  71. 21110  HTAB T: PRINT "<SPACE> ... ANOTHER CHOICE"
  72. 21120  HTAB T: PRINT "  <RTN> ... RETURN TO MENU"
  73. 21150  VTAB 23: HTAB 1: GET A$
  74. 21160  IF A$ < > CHR$(8)  THEN 21180
  75. 21170 M = M -1: IF M > = 1  THEN 21174
  76. 21172 M = 12:Y = Y -1
  77. 21174  GOSUB 5000: GOTO 21150
  78. 21180  IF A$ < > CHR$(21)  THEN 21190
  79. 21182 M = M +1: IF M <13  THEN 21186
  80. 21184 M = 1:Y = Y +1
  81. 21186  GOSUB 5000: GOTO 21150
  82. 21190  IF A$ < > CHR$(32)  THEN 21210
  83. 21200  GOSUB 3000: REM  CHOICE
  84. 21202  GOSUB 5000: REM  DISPLAY MONTH
  85. 21204  GOTO 21150
  86. 21210  IF A$ =  CHR$(13)  THEN 21900
  87. 21220  GOTO 21150: REM IGNORE
  88. 21900  RETURN 
  89. 22000  REM **** PRINTER MENU ****
  90. 22002  PRINT "OTTAWA 6502 USER GROUP -- POB 6283 STN J -- OTTAWA -- K1P 5R3"
  91. 22010  TEXT : HOME 
  92. 22015  VTAB 6
  93. 22020  INPUT "PRINTER SLOT? (1-4) ";SLOT
  94. 22030  IF SLOT <1  OR SLOT >4  THEN  PRINT  CHR$(7);"PARDON?": GOTO 22020
  95. 22040  PRINT : PRINT 
  96. 22050  INPUT "WHICH YEAR?(YYYY): ";Y0$
  97. 22052  IF  LEN(Y0$) < >4  THEN 22050
  98. 22054 Y1 =  VAL( LEFT$(Y0$,1)):Y2 =  VAL( MID$ (Y0$,2,1)):Y3 =  VAL( MID$ (Y0$,3,1)):Y4 =  VAL( RIGHT$(Y0$,1))
  99. 22056 Y =  VAL(Y0$)
  100. 22060  IF Y <1582  OR Y >2999  THEN  PRINT  CHR$(7);"PARDON?": GOTO 22050
  101. 22062  PRINT 
  102. 22064  INPUT "HOW MANY COPIES?(1-20): ";NC%: IF NC% <1  OR NC% >20  THEN 22062
  103. 22066  PRINT : PRINT 
  104. 22070  PRINT "START UP THE PRINTER, THEN"
  105. 22080  PRINT "PRESS A KEY   ";: GET A$
  106. 22090  PRINT : PRINT : HTAB 15: PRINT "... STANDBY ..."
  107. 22100  PRINT : PRINT : PRINT 
  108. 22200  PR# SLOT
  109. 22201  PRINT  CHR$(9);"80N"
  110. 22210  FOR CN = 1 TO NC%
  111. 22220  PRINT  CHR$(32)
  112. 22222  PRINT  CHR$(32)
  113. 22224  FOR L = 1 TO 7
  114. 22226  FOR I = 1 TO 20: PRINT  CHR$(32);: NEXT 
  115. 22228  PRINT Y$(L,Y1 +1);"    ";Y$(L,Y2 +1);"    ";Y$(L,Y3 +1);"    ";Y$(L,Y4 +1)
  116. 22230  NEXT 
  117. 22232  PRINT  CHR$(32): PRINT  CHR$(32)
  118. 22234  PRINT  CHR$(32)
  119. 22240  FOR A = 0 TO 3
  120. 22250  GOSUB 6010
  121. 22260  PRINT LINE$(7)
  122. 22262 A$ = "S  M  T  W  T  F  S"
  123. 22264  PRINT "   ";A$;"        ";A$;"        ";A$
  124. 22270  FOR I = 1 TO 6: PRINT LINE$(I): NEXT 
  125. 22280  FOR I = 1 TO 3: PRINT  CHR$(32): NEXT 
  126. 22290  NEXT A
  127. 22291  PRINT "<<< HAVE A GREAT YEAR! >>>"
  128. 22292  PRINT "OTTAWA 6502 USER GROUP -- POB 6283 STN J -- OTTAWA -- K2A 1T3"
  129. 22300  FOR I = 1 TO 8: PRINT  CHR$(32): NEXT 
  130. 22400  NEXT CN
  131. 22500  PR# 0
  132. 22990  RETURN 
  133. 30000  REM **** CONSTANTS ****
  134. 30010 D0 = 3: REM PHASE DAY OF WEEK
  135. 30050  REM START THE YEAR ON MARCH FIRST AND TABLE THE
  136. 30052  REM FIRST DAY OF EACH MONTH.  THIS WORKS WHEN
  137. 30054  REM FEBRUARY IS THE LAST MONTH OF THE YEAR!
  138. 30100  DIM F0(12): DATA 0,31,61,92,122,153,184,214,245,275,306,337: FOR I = 1 TO 12: READ F0(I): NEXT 
  139. 30120  DIM MO$(12): DATA MARCH,APRIL,MAY,JUNE,JULY,AUGUST,SEPTEMBER,OCTOBER,NOVEMBER,DECEMBER
  140. 30130  DATA JANUARY,FEBRUARY: FOR I = 1 TO 12: READ MO$(I): NEXT 
  141. 30140  DIM LINE$(7)
  142. 30150  DIM T(3):T(1) = 1:T(2) = 28:T(3) = 55
  143. 30200  REM  ZERO
  144. 30201  DATA " **** "
  145. 30202  DATA "**  **"
  146. 30203  DATA "**  **"
  147. 30204  DATA "**  **"
  148. 30205  DATA "**  **"
  149. 30206  DATA "**  **"
  150. 30207  DATA " **** "  
  151. 30210  REM  ONE
  152. 30211  DATA "  **  "
  153. 30212  DATA " ***  "
  154. 30213  DATA "  **  "
  155. 30214  DATA "  **  "
  156. 30215  DATA "  **  "
  157. 30216  DATA "  **  "
  158. 30217  DATA " **** "
  159. 30220  REM TWO
  160. 30221  DATA " **** "
  161. 30222  DATA "**  **"
  162. 30223  DATA "**  **"
  163. 30224  DATA "   ** "
  164. 30225  DATA " **   "
  165. 30226  DATA "**    "
  166. 30227  DATA "******"
  167. 30230  REM THREE
  168. 30231  DATA " **** " 
  169. 30232  DATA "**  **"
  170. 30233  DATA "    **"
  171. 30234  DATA "   ** "
  172. 30235  DATA "    **"
  173. 30236  DATA "**  **"
  174. 30237  DATA " **** " 
  175. 30240  REM FOUR
  176. 30241  DATA "   ** "
  177. 30242  DATA "  *** "
  178. 30243  DATA " * ** "
  179. 30244  DATA "******"
  180. 30245  DATA "   ** "
  181. 30246  DATA "   ** "
  182. 30247  DATA "   ** "
  183. 30250  REM FIVE
  184. 30251  DATA "******"
  185. 30252  DATA "**    "
  186. 30253  DATA "**    "
  187. 30254  DATA "***** "
  188. 30255  DATA "    **"
  189. 30256  DATA "**  **"
  190. 30257  DATA " **** "
  191. 30260  REM SIX
  192. 30261  DATA " **** "
  193. 30262  DATA "**  **"
  194. 30263  DATA "**    "
  195. 30264  DATA "***** "
  196. 30265  DATA "**  **"
  197. 30266  DATA "**  **"
  198. 30267  DATA " **** " 
  199. 30270  REM SEVEN
  200. 30271  DATA "******"
  201. 30272  DATA "*   **"
  202. 30273  DATA "   ** "
  203. 30274  DATA "  **  "
  204. 30275  DATA " **   "
  205. 30276  DATA "**    "
  206. 30277  DATA "**    "
  207. 30280  REM EIGHT
  208. 30281  DATA " **** "
  209. 30282  DATA "**  **"
  210. 30283  DATA "**  **"
  211. 30284  DATA " **** "
  212. 30285  DATA "**  **"
  213. 30286  DATA "**  **"
  214. 30287  DATA " **** " 
  215. 30290  REM NINE
  216. 30291  DATA " **** " 
  217. 30292  DATA "**  **"
  218. 30293  DATA "**  **"
  219. 30294  DATA " **** "
  220. 30295  DATA "  **  "
  221. 30296  DATA " **   "
  222. 30297  DATA "**    "
  223. 30300  DIM Y$(7,10)
  224. 30310  FOR I = 1 TO 10
  225. 30320  FOR J = 1 TO 7: READ Y$(J,I): NEXT 
  226. 30330  NEXT 
  227. 30990  REM 
  228. 30992  REM 
  229. 31000  REM **** MAINLINE MENU ****
  230. 31010  TEXT : HOME : NORMAL : SPEED= 255
  231. 31020  VTAB 3: HTAB 16: PRINT "CALENDAR"
  232. 31022  PRINT : HTAB 6
  233. 31024  PRINT "FROM THE OTTAWA 6502 USER GROUP"
  234. 31026  PRINT : HTAB 9: PRINT "WRITTEN BY PAUL IRWIN"
  235. 31030 T = 12: VTAB 10
  236. 31040  HTAB 5: PRINT "A PERPETUAL CALENDAR PROGRAM FOR"
  237. 31050  PRINT "YOUR CHOICE OF SCREEN OR PRINTER:"
  238. 31060  PRINT : HTAB T: PRINT "S ... SCREEN"
  239. 31070  PRINT : HTAB T: PRINT "P ... PRINTER"
  240. 31080  PRINT : HTAB T -4: PRINT "<RTN> ... RETURN TO BASIC"
  241. 31120 X =  FRE(0)
  242. 31130  VTAB 20: HTAB 16: PRINT "WHICH? ";: GET A$
  243. 31140  IF A$ < >"S"  THEN 31160
  244. 31150  GOSUB 21000: GOTO 31010
  245. 31160  IF A$ < >"P"  THEN 31180
  246. 31170  GOSUB 22000: GOTO 31010
  247. 31180  IF A$ < > CHR$(13)  THEN 31130
  248. 32000  TEXT : HOME : VTAB 12: HTAB 9
  249. 32010  PRINT "CALENDAR IS OFF THE AIR"
  250. 32020  VTAB 23
  251. 32767  END 
  252. 40000  REM ***** CALENDAR *****
  253. 40001  REM * WRITTEN 1980 BY  *
  254. 40002  REM *    PAUL IRWIN    *
  255. 40003  REM *  (613) 728-6728  *
  256. 40004  REM ********************